home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / surfsrc3.zip / SURFACE.INC < prev    next >
Text File  |  1991-09-28  |  4KB  |  137 lines
  1. procedure SURFACE;
  2.  
  3. { Make a surface model drawing of the object }
  4. var Node:                      word;          { node # }
  5.     Surf:                      word;          { surface # }
  6.     Node1:                     word;          { 1st node of surface }
  7.     Shade:                     real;          { shade of surface }
  8.     Count:                     integer;       { # vertices in shadow }
  9.     Vert:                      integer;       { vertex # }
  10.     User_abort:                boolean;       { did the user abort? }
  11.     ch:                        char;
  12. {$ifndef BIGMEM}
  13.     Shades: nodearray;
  14.       { shade at each node }
  15.     Surfmin, Surfmax: surfaces;
  16.       { surface minimum & maximum (Ztran) }
  17. {$endif}
  18. label ABORTTEXT,                              { text-mode abort }
  19.       ABORTGRPH;                              { graphics-mode abort }
  20.  
  21. begin
  22. {$ifdef BIGMEM}
  23. with ptra^ do with ptrb^ do with ptrc^ do
  24. with ptrd^ do with ptre^ do with ptrf^ do
  25. with ptrh^ do with ptri^ do with ptrj^ do
  26. with ptrk^ do with ptrn^ do
  27. begin
  28. {$endif}
  29.   perf_start;
  30.   User_abort := TRUE;
  31.   if (checkey) then goto ABORTTEXT;
  32. {$ifndef NOSHADOW}
  33.   if (Shadowing) then
  34.     shadows (Shades)
  35.   else
  36. {$else}
  37.   if (Shadowing) then
  38.     writeln ('Error: Shadows not implemented in this version')
  39.   else
  40. {$endif}
  41.     for Node := 1 to Nnodes do
  42.       Shades[Node] := 0.0;
  43.  
  44.   if (Viewchanged) or (Shadowing) then begin
  45.     menumsg ('Transforming to 2-D...');
  46.     if (checkey) then goto ABORTTEXT;
  47. { Transform from 3-D to 2-D coordinates }
  48.     setorigin;
  49.     for Node := 1 to Nnodes do
  50.       perspect (Xworld[Node], Yworld[Node], Zworld[Node],
  51.                 Xtran[Node],  Ytran[Node],  Ztran[Node]);
  52.  
  53.     if (checkey) then goto ABORTTEXT;
  54. { Set plotting limits and normalize transformed coords to screen coords }
  55.     perspect (Xfocal, Yfocal, Zfocal, Xfotran, Yfotran, Zfotran);
  56.     if (not setnormal (Xfotran, Yfotran, XYmax)) then begin
  57.       menumsg ('Warning: Focal point outside data limits.');
  58.       writeln;
  59.       write   ('  Press any key ...');
  60.       ch := readkey;
  61.     { Erase the previous message }
  62.       menumsg ('');
  63.       writeln;
  64.       write ('                          ');
  65.     end;
  66.  
  67.     if (checkey) then goto ABORTTEXT;
  68. { Normalize all the nodes }
  69.     for Node := 1 to Nnodes do
  70.       normalize (Xtran[Node], Ytran[Node], Xfotran, Yfotran, XYmax);
  71.  
  72.     if (checkey) then goto ABORTTEXT;
  73.     menumsg ('Sorting surfaces...');
  74.     minmax (Surfmin, Surfmax, Nsurf);
  75.     shelsurf (Surfmin, Surfmax, Nsurf);
  76.     Viewchanged := FALSE;
  77.   end; { if Viewchanged }
  78.  
  79.   setshade;                            { Setup for shading calculations }
  80.  
  81. {$ifdef USE_IFF}
  82.   menumsg ('Plotting...');
  83. {$endif}
  84.  
  85.   setgmode (Nmatl);
  86.   for Surf := 1 to Nsurf do begin
  87.     Count := 0;
  88.     if (Shadowing) then begin
  89.       { Count the number of vertices that are in a shadow }
  90.       for Vert := 1 to Nvert[Surf] do
  91.         if (Shades[konnec (Surf, Vert)] < 0.0) then
  92.           Count := Count + 1;
  93.     end;
  94. { In a shadow if any vertex of the surface is in shadow }
  95.     if (Count < 1) then begin
  96.       { Not in shadow }
  97.       Node1 := konnec (Surf, 1);
  98.       if (Nsides = 2) then begin
  99.         { do the secondary surface first, if desired }
  100.         Shade := shading (Surf, 2);
  101.         if (Shade >= 0.0) then
  102.           fillsurf (Surf, Matl[Surf], Shade);
  103.       end;
  104.       Shade := shading (Surf, 1);
  105.       if (Shade >= 0.0) then
  106.         fillsurf (Surf, Matl[Surf], Shade);
  107.     end else
  108.       { In a shadow - show at ambient light intensity }
  109.       fillsurf (Surf, Matl[Surf], Ambient[Matl[Surf]]);
  110.     { Show border of surface, if requested }
  111.     if (ShowAllBorders > 0) then
  112.       border (Surf, Matl[Surf]);
  113.     if (grafstat) then goto ABORTGRPH;
  114.   end; { for Surf }
  115.   drawaxes (Xfotran, Yfotran, XYmax);
  116.  
  117.   perf_stop (4);
  118.  
  119. {$ifdef USE_IFF}
  120.   menumsg ('Saving IFF...');
  121.   saveiff (Filemask + '.IFF', VGApal);
  122. {$else}
  123.   { Wait for user keypress to continue }
  124.   continue;
  125. {$endif}
  126.   User_abort := FALSE;
  127.  
  128.   ABORTGRPH:
  129.   exgraphic;
  130.   ABORTTEXT:
  131.   if (User_abort) then
  132.     perf_stop (0);
  133. {$ifdef BIGMEM}
  134. end; {with}
  135. {$endif}
  136. end; {procedure SURFACE }
  137.